Pascal Super Library/Pascal Super Library (CW International)(1997).bin/TURB_VIS/MACROS/LISTS.PAS

Pascal/Delphi Source File | 1992-01-29 | 6KB | 218 lines

Unit Lists;
(***************************************************************************
          Implements a generic Stack Object and Queue Object.
          Copyright 1992 Cybersoft - All Rights Reserved.
 ***************************************************************************)

{
The stack is a singly linked list. An object of TYPE = TSTACK is implemented.
Methods include Init, Done, Push and Pop. Fields include Head (of the stack),
and Size (of the data record, set with Init).

The queue is a circular doubly linked list, for easy insertion at the tail,
and easy extraction from the head. An object of TYPE = TQUEUE is implemented.
Methods include Init, Done, Insert and Extract. Fields include Head (of the
queue), and Size (of the data record, set with Init).

Both objects receive and return pointers to PRE-ALLOCATED data records. It
is up the programmer to allocate and deallocate the pointers to the data
records.
}

interface

type
     (* ---- STACKS ---- *)

     PStackItem = ^TStackItem;
     TStackItem = record
                    Next: PStackItem;     { To successor     }
                    Data: Pointer;
                  end;

     PStack = ^TStack;
     TStack = object
                Head    : PStackItem;
                RecSize : Integer;
                NotEmpty      : boolean;

                constructor Init (RecordSize : Integer);
                destructor Done; virtual;
                procedure Push (Item : Pointer);
                function Pop : Pointer;
              end;


     (* ---- QUEUES ---- *)

     PQueueItem = ^TQueueItem;
     TQueueItem = record
                    Prev, Next : PQueueItem;
                    Data       : Pointer;
                  end;

     PQueue = ^TQueue;
     TQueue = object
                Head    : PQueueItem;
                RecSize : Integer;
                NotEmpty      : boolean;

                constructor Init (RecordSize : Integer);
                destructor Done; virtual;
                procedure Insert (Item : Pointer);
                function Extract : Pointer;
              end;

implementation

(* ------------------------------- STACK -------------------------------- *)

constructor TStack.Init (RecordSize : Integer);
begin
  Head := nil;
  RecSize := RecordSize;
  NotEmpty := false;
end;


{Disposes of entire stack}

destructor TStack.Done;
var P : PStackItem;
begin
  while Head <> nil do
  begin
    P := Head;
    Head := P^.Next;
    if P <> nil then
    begin
      FreeMem (P^.Data, RecSize);
      dispose (P);
    end;
  end;
  NotEmpty := false;
end;


{Item is a pointer to a data record of any type, size of TStack.RecSize}

procedure TStack.Push (Item : Pointer);
var P : PStackItem;
begin
  new (P);
  if Head <> nil then P^.Next := Head else P^.Next := nil;
  Head := P;
  Head^.Data := Item;
  NotEmpty := true;
end;



{Pops the item off the stack, and returns a pointer to the data record, and
 removes the item from the stack. If the stack is empty, nil is returned.}

Function TStack.Pop : Pointer;
var P : PStackItem;
begin
  if Head = nil then
  begin
    Pop := nil;
    exit;
  end;
  Pop := Head^.Data;
  P := Head^.Next;
  dispose (Head);
  Head := P;
  if P = nil then NotEmpty := false;
end;


(* ------------------------------- QUEUE -------------------------------- *)

constructor TQueue.Init (RecordSize : Integer);
begin
  RecSize := RecordSize;
  Head := nil;
  NotEmpty := false;
end;


{disposes of the entire queue by popping off and disposing the head.}

destructor TQueue.Done;
var Next, Prev : PQueueItem;
begin
  if Head = nil then exit;                      { Queue is empty.          }
  while Head^.Next <> Head do                   { 2 or more items in queue.}
  begin
    Next := Head^.Next;
    Prev := Head^.Prev;
    Next^.Prev := Prev;
    Prev^.Next := Next;
    FreeMem (Head^.Data, RecSize);
    dispose (Head);
    Head := Next;
  end;
  FreeMem (Head^.Data, RecSize);                { Head is the only item.  }
  dispose (Head);
  Head := nil;
  NotEmpty := false;
end;


{ Inserts item at the tail of the queue. }

procedure TQueue.Insert (Item : Pointer);
var P : PQueueItem;
begin
  new (P);
  P^.Data := Item;

  if Head <> nil then                           { Queue is not empty.     }
  begin
    P^.Prev := Head^.Prev;
    P^.Next := Head;
    Head^.Prev^.Next := P;
    Head^.Prev := P;
  end
  else                                          { Queue is empty.         }
  begin
    Head := P;
    P^.Next := P;
    P^.Prev := P;
  end;

  NotEmpty := true;                                   { Queue is not empty.     }

end;


{ Returns pointer to data record of item at the head of the queue, and
  replaces/disposes of Queue Head item, moving the queue up 1 item. }

function TQueue.Extract : Pointer;
var P : PQueueItem;
begin
  if Head <> nil then                    {at least one item}
  begin
    Extract := Head^.Data;
    if Head^.Next <> Head then           {more than one item}
    begin
      P := Head;
      Head := P^.Next;
      Head^.Prev := P^.Prev;
      P^.Prev^.Next := Head;
      dispose (P);
    end
    else
    begin                                {only one item}
      dispose (Head);
      Head := nil;
      NotEmpty := false;
    end;
  end
  else
    Extract := nil;
end;

end.